home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
pcl10.arc
/
CALLPGM.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-07-20
|
4KB
|
115 lines
(*************************************)
(* *)
(* CALLPGM.PAS 1.0 *)
(* *)
(* Simple terminal emulator to *)
(* test the PCL functions *)
(* *)
(*************************************)
program term;
uses PCL;
const
BaudCode = Baud38400; (* Choose baud rate: Baud300 to Baud115200 *)
var
Buffer : array[0..1024] of Char;
RetCode : Integer;
Byte : Char;
i : Integer;
Port : Integer;
ResetFlag : Boolean;
procedure SayError( Code : Integer );
var
RetCode : Integer;
begin
if Code < 0 then RetCode := SioError( Code )
else if (Code and (FramingError or ParityError or OverrunError)) <> 0 then
begin (* Port Error *)
if (Code and FramingError) <> 0 then writeln('Framing Error');
if (Code and ParityError) <> 0 then writeln('Parity Error');
if (Code and OverrunError) <> 0 then writeln('Overrun Error')
end
end;
procedure MyHalt( Code : Integer );
var
RetCode : Integer;
begin
SayError( Code );
if ResetFlag then RetCode := SioDone(Port);
Halt;
end;
begin (* main program *)
ResetFlag := FALSE;
(* fetch PORT # from command line *)
if ParamCount <> 1 then
begin
writeln('USAGE: "CALLPGM <port>" where port = 1,2,3, or 4');
halt;
end;
Val( ParamStr(1),Port, RetCode );
if RetCode <> 0 then
begin
writeln('Port must be 1 to 4');
Halt;
end;
(* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
Port := Port - 1;
if (Port<COM1) or (Port>COM4) then
begin
writeln('Port must be 1 to 4');
Halt
end;
(* setup receive 1K receive buffer *)
RetCode := SioRxBuf(Port, Ofs(Buffer), Seg(Buffer), Size1024);
if RetCode < 0 then MyHalt( RetCode );
(* attempt to reset port *)
i := 0;
repeat
i := i + 1;
RetCode := SioReset(Port,BaudCode);
if RetCode <> 0 then SayError(RetCode);
until (RetCode = 0) or (i > 5);
(* Was port reset ? *)
if RetCode <> 0 then
begin
writeln('Cannot reset COM',Port+1);
MyHalt( RetCode );
end;
(* Port successfully reset *)
ResetFlag := TRUE;
(* specify parity, # stop bits, and word length for port *)
RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
if RetCode < 0 then MyHalt( RetCode );
writeln; writeln(' CALLPGM 1.0: COM',1+Port,': 38400 Baud: Type ESC to quit');
RetCode := SioRxFlush(Port);
if RetCode < 0 then MyHalt( RetCode );
(* begin terminal loop *)
while TRUE do
begin
(* anything incoming over serial port ? *)
RetCode := SioGetc(Port,0);
if RetCode < -1 then MyHalt( RetCode );
if RetCode > -1 then RetCode := SioCrtWrite( chr(RetCode) );
(* has user pressed keyboard ? *)
if SioKeyPress then
begin
(* read keyboard *)
Byte := SioKeyRead;
(* quit if user types ESC *)
if Byte = chr($1b) then
begin
writeln('User typed ESC');
RetCode := SioDone(Port);
Halt;
end;
(* send out over serial line *)
RetCode := SioPutc(Port, Byte );
if RetCode < 0 then MyHalt( RetCode );
end
end
end.